home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / sparc / sap.lisp < prev    next >
Encoding:
Text File  |  1992-05-19  |  7.5 KB  |  288 lines
  1. ;;; -*- Package: SPARC -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: sap.lisp,v 1.5 92/04/27 20:04:06 wlott Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; This file contains the SPARC VM definition of SAP operations.
  15. ;;;
  16. ;;; Written by William Lott.
  17. ;;;
  18. (in-package "SPARC")
  19.  
  20.  
  21. ;;;; Moves and coercions:
  22.  
  23. ;;; Move a tagged SAP to an untagged representation.
  24. ;;;
  25. (define-vop (move-to-sap)
  26.   (:args (x :scs (any-reg descriptor-reg)))
  27.   (:results (y :scs (sap-reg)))
  28.   (:note "pointer to SAP coercion")
  29.   (:generator 1
  30.     (loadw y x sap-pointer-slot other-pointer-type)))
  31.  
  32. ;;;
  33. (define-move-vop move-to-sap :move
  34.   (descriptor-reg) (sap-reg))
  35.  
  36.  
  37. ;;; Move an untagged SAP to a tagged representation.
  38. ;;;
  39. (define-vop (move-from-sap)
  40.   (:args (sap :scs (sap-reg) :to :save))
  41.   (:temporary (:scs (non-descriptor-reg)) ndescr)
  42.   (:results (res :scs (descriptor-reg)))
  43.   (:note "SAP to pointer coercion") 
  44.   (:generator 20
  45.     (with-fixed-allocation (res ndescr sap-type sap-size)
  46.       (storew sap res sap-pointer-slot other-pointer-type))))
  47. ;;;
  48. (define-move-vop move-from-sap :move
  49.   (sap-reg) (descriptor-reg))
  50.  
  51.  
  52. ;;; Move untagged sap values.
  53. ;;;
  54. (define-vop (sap-move)
  55.   (:args (x :target y
  56.         :scs (sap-reg)
  57.         :load-if (not (location= x y))))
  58.   (:results (y :scs (sap-reg)
  59.            :load-if (not (location= x y))))
  60.   (:note "SAP move")
  61.   (:effects)
  62.   (:affected)
  63.   (:generator 0
  64.     (move y x)))
  65. ;;;
  66. (define-move-vop sap-move :move
  67.   (sap-reg) (sap-reg))
  68.  
  69.  
  70. ;;; Move untagged sap arguments/return-values.
  71. ;;;
  72. (define-vop (move-sap-argument)
  73.   (:args (x :target y
  74.         :scs (sap-reg))
  75.      (fp :scs (any-reg)
  76.          :load-if (not (sc-is y sap-reg))))
  77.   (:results (y))
  78.   (:note "SAP argument move")
  79.   (:generator 0
  80.     (sc-case y
  81.       (sap-reg
  82.        (move y x))
  83.       (sap-stack
  84.        (storew x fp (tn-offset y))))))
  85. ;;;
  86. (define-move-vop move-sap-argument :move-argument
  87.   (descriptor-reg sap-reg) (sap-reg))
  88.  
  89.  
  90. ;;; Use standard MOVE-ARGUMENT + coercion to move an untagged sap to a
  91. ;;; descriptor passing location.
  92. ;;;
  93. (define-move-vop move-argument :move-argument
  94.   (sap-reg) (descriptor-reg))
  95.  
  96.  
  97.  
  98. ;;;; SAP-INT and INT-SAP
  99.  
  100. (define-vop (sap-int)
  101.   (:args (sap :scs (sap-reg) :target int))
  102.   (:arg-types system-area-pointer)
  103.   (:results (int :scs (unsigned-reg)))
  104.   (:result-types unsigned-num)
  105.   (:translate sap-int)
  106.   (:policy :fast-safe)
  107.   (:generator 1
  108.     (move int sap)))
  109.  
  110. (define-vop (int-sap)
  111.   (:args (int :scs (unsigned-reg) :target sap))
  112.   (:arg-types unsigned-num)
  113.   (:results (sap :scs (sap-reg)))
  114.   (:result-types system-area-pointer)
  115.   (:translate int-sap)
  116.   (:policy :fast-safe)
  117.   (:generator 1
  118.     (move sap int)))
  119.  
  120.  
  121.  
  122. ;;;; POINTER+ and POINTER-
  123.  
  124. (define-vop (pointer+)
  125.   (:translate sap+)
  126.   (:args (ptr :scs (sap-reg))
  127.      (offset :scs (signed-reg)))
  128.   (:arg-types system-area-pointer signed-num)
  129.   (:results (res :scs (sap-reg)))
  130.   (:result-types system-area-pointer)
  131.   (:policy :fast-safe)
  132.   (:generator 2
  133.     (inst add res ptr offset)))
  134.  
  135. (define-vop (pointer+-c)
  136.   (:translate sap+)
  137.   (:args (ptr :scs (sap-reg)))
  138.   (:info offset)
  139.   (:arg-types system-area-pointer (:constant (signed-byte 13)))
  140.   (:results (res :scs (sap-reg)))
  141.   (:result-types system-area-pointer)
  142.   (:policy :fast-safe)
  143.   (:generator 1
  144.     (inst add res ptr offset)))
  145.  
  146. (define-vop (pointer-)
  147.   (:translate sap-)
  148.   (:args (ptr1 :scs (sap-reg))
  149.      (ptr2 :scs (sap-reg)))
  150.   (:arg-types system-area-pointer system-area-pointer)
  151.   (:policy :fast-safe)
  152.   (:results (res :scs (signed-reg)))
  153.   (:result-types signed-num)
  154.   (:generator 1
  155.     (inst sub res ptr1 ptr2)))
  156.  
  157.  
  158.  
  159. ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
  160.  
  161. (eval-when (compile eval)
  162.  
  163. (defmacro def-system-ref-and-set
  164.       (ref-name set-name sc type size &optional signed)
  165.   (let ((ref-name-c (symbolicate ref-name "-C"))
  166.     (set-name-c (symbolicate set-name "-C")))
  167.     `(progn
  168.        (define-vop (,ref-name)
  169.      (:translate ,ref-name)
  170.      (:policy :fast-safe)
  171.      (:args (sap :scs (sap-reg))
  172.         (offset :scs (unsigned-reg)))
  173.      (:arg-types system-area-pointer unsigned-num)
  174.      (:results (result :scs (,sc)))
  175.      (:result-types ,type)
  176.      (:generator 5
  177.        (inst ,(ecase size
  178.             (:byte (if signed 'ldsb 'ldub))
  179.             (:short (if signed 'ldsh 'lduh))
  180.             (:long 'ld)
  181.             (:single 'ldf)
  182.             (:double 'lddf))
  183.          result sap offset)))
  184.        (define-vop (,ref-name-c)
  185.      (:translate ,ref-name)
  186.      (:policy :fast-safe)
  187.      (:args (sap :scs (sap-reg)))
  188.      (:arg-types system-area-pointer (:constant (signed-byte 13)))
  189.      (:info offset)
  190.      (:results (result :scs (,sc)))
  191.      (:result-types ,type)
  192.      (:generator 4
  193.        (inst ,(ecase size
  194.             (:byte (if signed 'ldsb 'ldub))
  195.             (:short (if signed 'ldsh 'lduh))
  196.             (:long 'ld)
  197.             (:single 'ldf)
  198.             (:double 'lddf))
  199.          result sap offset)))
  200.        (define-vop (,set-name)
  201.      (:translate ,set-name)
  202.      (:policy :fast-safe)
  203.      (:args (sap :scs (sap-reg))
  204.         (offset :scs (unsigned-reg))
  205.         (value :scs (,sc) :target result))
  206.      (:arg-types system-area-pointer unsigned-num ,type)
  207.      (:results (result :scs (,sc)))
  208.      (:result-types ,type)
  209.      (:generator 5
  210.        (inst ,(ecase size
  211.             (:byte 'stb)
  212.             (:short 'sth)
  213.             (:long 'st)
  214.             (:single 'stf)
  215.             (:double 'stdf))
  216.          value sap offset)
  217.        (unless (location= result value)
  218.          ,@(case size
  219.          (:single
  220.           '((inst fmovs result value)))
  221.          (:double
  222.           '((inst fmovs result value)
  223.             (inst fmovs-odd result value)))
  224.          (t
  225.           '((inst move result value)))))))
  226.        (define-vop (,set-name-c)
  227.      (:translate ,set-name)
  228.      (:policy :fast-safe)
  229.      (:args (sap :scs (sap-reg))
  230.         (value :scs (,sc) :target result))
  231.      (:arg-types system-area-pointer (:constant (signed-byte 13)) ,type)
  232.      (:info offset)
  233.      (:results (result :scs (,sc)))
  234.      (:result-types ,type)
  235.      (:generator 4
  236.        (inst ,(ecase size
  237.             (:byte 'stb)
  238.             (:short 'sth)
  239.             (:long 'st)
  240.             (:single 'stf)
  241.             (:double 'stdf))
  242.          value sap offset)
  243.        (unless (location= result value)
  244.          ,@(case size
  245.          (:single
  246.           '((inst fmovs result value)))
  247.          (:double
  248.           '((inst fmovs result value)
  249.             (inst fmovs-odd result value)))
  250.          (t
  251.           '((inst move result value))))))))))
  252.  
  253. ); eval-when (compile eval)
  254.  
  255. (def-system-ref-and-set sap-ref-8 %set-sap-ref-8
  256.   unsigned-reg positive-fixnum :byte nil)
  257. (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8
  258.   signed-reg tagged-num :byte t)
  259. (def-system-ref-and-set sap-ref-16 %set-sap-ref-16
  260.   unsigned-reg positive-fixnum :short nil)
  261. (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16
  262.   signed-reg tagged-num :short t)
  263. (def-system-ref-and-set sap-ref-32 %set-sap-ref-32
  264.   unsigned-reg unsigned-num :long nil)
  265. (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32
  266.   signed-reg signed-num :long t)
  267. (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap
  268.   sap-reg system-area-pointer :long)
  269. (def-system-ref-and-set sap-ref-single %set-sap-ref-single
  270.   single-reg single-float :single)
  271. (def-system-ref-and-set sap-ref-double %set-sap-ref-double
  272.   double-reg double-float :double)
  273.  
  274.  
  275.  
  276. ;;; Noise to convert normal lisp data objects into SAPs.
  277.  
  278. (define-vop (vector-sap)
  279.   (:translate vector-sap)
  280.   (:policy :fast-safe)
  281.   (:args (vector :scs (descriptor-reg)))
  282.   (:results (sap :scs (sap-reg)))
  283.   (:result-types system-area-pointer)
  284.   (:generator 2
  285.     (inst add sap vector
  286.       (- (* vector-data-offset word-bytes) other-pointer-type))))
  287.  
  288.